home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 013 / resdir.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-01-03  |  47.0 KB  |  1,155 lines
  1. {$C-}
  2. {
  3.    THE "STAYRES" code is here in a stripped-down version, without some
  4.    of its explanatory comments and without the modification history.
  5.  
  6.   COMPILE with mAx and mIn both set to 300
  7.  
  8.  
  9. The Hunter's Helper
  10.  
  11. Lane Ferris
  12. 4268 26th St
  13. San Francisco,Ca. 94131
  14. [ 70357,2716 ]
  15.  
  16. If you find this program useful, $15 would be appeciated to help in its
  17. evolution and upkeep.
  18.  
  19. }
  20. PROGRAM Resident_MAP;
  21.  
  22.   { * * * * * * * CONSTANTS * * * * * * * * * * * * * * * * * * * * * * }
  23. CONST
  24.   {      the next field is needed for the windo.inc routines }
  25.   MaxWin = 2;                 { Max number of windows open at one time }
  26.   Esc = #27;                  {character equivalent of Escape Key}
  27.   Our_Char = 113;             {this is the scan code for Alt-F10}
  28.   Ctrl_Home = #119;           {Control Home Scan Code          }
  29.   Ctrl_End = #117;            {Control End Scan Code           }
  30.   Quit_Key = Ctrl_Home;         {Quit and Release Memory}
  31.   Kybrd_Int = $16;            {BIOS keyboard interrupt}
  32.  
  33.   {------------- T Y P E    D E C L A R A T I O N S ----------------------}
  34. TYPE
  35.   Regtype = RECORD Ax, Bx, Cx, Dx, Bp, Si, Di, Ds, Es, Flags : Integer END;
  36.   HalfRegtype = RECORD Al, Ah, Bl, Bh, Cl, Ch, Dl, Dh : Byte END;
  37.   filename_type = STRING[64];
  38.  
  39.   {-------------- T Y P E D   C O N S T A N T S --------------------------}
  40. CONST
  41.   {regs is defined as a typed constant to get it in the code segment}
  42.   Regs : regtype = (Ax : 0; Bx : 0; Cx : 0; Dx : 0; Bp : 0; Si : 0; Di : 0; Ds : 0; Es : 0; Flags : 0);
  43.  
  44.   OurDseg : Integer = 0;      {Our Data Segment Value             }
  45.   OurSseg : Integer = 0;      {Our Stack Segment Value            }
  46.   DosSseg : Integer = 0;      {Dos Stack Segment Value            }
  47.   Inuse : Boolean = False;    {Recursion flag                     }
  48.   { The following two constants *MUST* remain in the IP:CS order        }
  49.   { because StaySave uses them as a JMP target                          }
  50.   DOS_IntIP : Integer = 0;    {Pointer to Original IP Int value   }
  51.   DOS_IntCs : Integer = 0;    {Pointer to Original Cs Int value   }
  52.   StackSize : Integer = 0;    {Current User/or Dos Stack word size}
  53.   {-------------- V A R I A B L E S ----------------------------------------}
  54. VAR
  55.   SaveRegs : regtype;
  56.   HalfRegs : halfregtype ABSOLUTE regs;
  57.   Terminate_flag : Boolean;
  58.   Keychr : Char;
  59.   Old_Xpos, Old_Ypos : Integer;
  60.   I : Integer;
  61.  
  62.   {-----------------------------------------------------------------------------}
  63.   {                 W  I  N  D  O  W     R  O  U  T  I  N  E                    }
  64.   {---------------------------------------------------------------------------- }
  65.  
  66.     {**********************************************************************}
  67.   {                         W I N D O . I N C                            }
  68.   {                                                                      }
  69.   {**********************************************************************}
  70.   {                 Kloned and Kludged by Lane Ferris                    }
  71.   {                     -- The Hunters Helper --                         }
  72.   {               Original Copyright 1984 by Michael A. Covington        }
  73.   {               Extensive Modifications by Lynn Canning 9/25/85        }
  74.   {                                          9107 Grandview Dr.          }
  75.   {                                          Overland Park, Ks. 66212    }
  76.   {                 1) Foreground and Background colors added.           }
  77.   {                    NOTE:  Monochrome monitors are automatically set  }
  78.   {                           to white on black.                         }
  79.   {                 2) Multiple borders added.                           }
  80.   {                 3) TimeDelay procedure added.                        }
  81.   {               Requirements: IBM PC or close compatible.              }
  82.   {----------------------------------------------------------------------}
  83.   { To make a window on the screen, call the procedure                   }
  84.   {      MkWin(x1,y1,x2,y2,FG,BG,BD);                                    }
  85.   {   The x and y coordinates define the window placement and are the    }
  86.   {   same as the Turbo Pascal Window coordinates.                       }
  87.   {   The border parameters (BD) are 0 = No border                       }
  88.   {                                  1 = Single line border              }
  89.   {                                  2 = Double line border              }
  90.   {   The foreground (FG) and background (BG) parameters are the same    }
  91.   {   values as the corresponding Turbo Pascal values.                   }
  92.   {                                                                      }
  93.   { The maximum number of windows open at one time is set at five        }
  94.   { (see MaxWin=5).  This may be set to greater values if necessary.     }
  95.   {                                                                      }
  96.   { After the window is made, you must write the text desired from the   }
  97.   { calling program.  Note that the usable text area is actually 1       }
  98.   { position smaller than the window coordinates to allow for the border.}
  99.   { Hence, a window defined as 1,1,80,25 would actually be 2,2,79,24     }
  100.   { after the border is created.  When writing to the window in your     }
  101.   { calling program, the textcolor and backgroundcolor may be changed as }
  102.   { desired by using the standard Turbo Pascal commands.                 }
  103.   {                                                                      }
  104.   { To return to the previous screen or window, call the procedure       }
  105.   {      RmWin;                                                          }
  106.   {                                                                      }
  107.   { The TimeDelay procedure is involked from your calling program.  It   }
  108.   { is similar to the Turbo Pascal DELAY except DELAY is based on clock  }
  109.   { speed whereas TimeDelay is based on the actual clock.  This means    }
  110.   { that the delay will be the same duration on all systems no matter    }
  111.   { what the clock speed.                                                }
  112.   { The procedure could be used for an error condition as follows:       }
  113.   {     MkWin          - make an error message window                    }
  114.   {     Writeln        - write error message to window                   }
  115.   {     TimeDelay(5)   - leave window on screen 5 seconds                }
  116.   {     RmWin          - remove error window                             }
  117.   {     cont processing                                                  }
  118.   {----------------------------------------------------------------------}
  119.  
  120. CONST
  121.  
  122.   InitDone : Boolean = False; { Initialization switch   }
  123.  
  124.   On = True;
  125.   Off = False;
  126.   VideoEnable = $08;          { Video Signal Enable Bit }
  127.   Bright = 8;                 { Bright Text bit}
  128. TYPE
  129.   Imagetype = ARRAY[1..4000] OF Char; { Screen Image in the heap    }
  130.   WinDimtype = RECORD
  131.                  x1, y1, x2, y2 : Integer
  132.                END;
  133.  
  134.   Screens = RECORD            { Save Screen Information     }
  135.               Image : Imagetype; { Saved screen Image }
  136.               Dim : WinDimtype; { Saved Window Dimensions }
  137.               x, y : Integer; { Saved cursor position }
  138.             END;
  139.  
  140.  
  141. VAR
  142.  
  143.   Win :                       { Global variable package }
  144.   RECORD
  145.     Dim : WinDimtype;         { Current Window Dimensions }
  146.     Depth : Integer;
  147.     { MaxWin should be included in your program }
  148.     { and it should be the number of windows saved }
  149.     { at one time }
  150.     { It should be in the const section of your program }
  151.     Stack : ARRAY[1..MaxWin] OF ^Screens;
  152.  
  153.   END;
  154.  
  155.   Crtmode : Byte ABSOLUTE $0040 : $0049; {Crt Mode,Mono,Color,B&W..}
  156.   Crtwidth : Byte ABSOLUTE $0040 : $004A; {Crt Mode Width, 40:80 .. }
  157.   Monobuffer : Imagetype ABSOLUTE $B000 : $0000; {Monochrome Adapter Memory}
  158.   Colorbuffer : Imagetype ABSOLUTE $B800 : $0000; {Color Adapter Memory     }
  159.   CrtAdapter : Integer ABSOLUTE $0040 : $0063; { Current Display Adapter }
  160.   VideoMode : Byte ABSOLUTE $0040 : $0065; { Video Port Mode byte    }
  161.   Video_Buffer : Integer;     { Record the current Video}
  162.   FG : Byte;                  {Foregound color value    }
  163.   BG : Integer;               {Background color value   }
  164.   BD : Integer;               {Border type Value 0..2   }
  165.   Switch : Boolean;
  166.   Delta,
  167.   Xtemp, Ytemp : Integer;
  168.   x, y : Integer;
  169.  
  170.   {------------------------------------------------------------------}
  171.   {                     Delay for  X seconds                         }
  172.   {------------------------------------------------------------------}
  173.  
  174.   PROCEDURE TimeDelay(hold : Integer);
  175.   TYPE
  176.     RegRec =                  { The data to pass to DOS }
  177.     RECORD
  178.       AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
  179.     END;
  180.   VAR
  181.     regs : regrec;
  182.     ah, al, ch, cl, dh : Byte;
  183.     sec : STRING[2];
  184.     tmptime, result, secn, error, secn2, diff : Integer;
  185.  
  186.   BEGIN
  187.     ah := $2c;                {Get Time-Of-Day from DOS}
  188.     WITH regs DO              {Will give back Ch:hours }
  189.       {Cl:minutes,Dh:seconds   }
  190.       ax := ah SHL 8+al;      {Dl:hundreds             }
  191.     Intr($21, regs);
  192.  
  193.     WITH regs DO
  194.       Str(dx SHR 8:2, sec);   {Get seconds      }
  195.     {with leading null}
  196.     IF (sec[1] = ' ') THEN
  197.       sec[1] := '0';
  198.     Val(sec, secn, error);    {Conver seconds to integer}
  199.     REPEAT                    { stay in this loop until the time }
  200.       ah := $2c;              { has expired }
  201.       WITH regs DO
  202.         ax := ah SHL 8+al;
  203.       Intr($21, regs);        {Get current time-of-day}
  204.  
  205.       WITH regs DO            {Normalize to Char}
  206.         Str(dx SHR 8:2, sec);
  207.       IF (sec[1] = ' ') THEN
  208.         sec[1] := '0';
  209.       Val(sec, secn2, error); {Convert seconds to integer}
  210.       diff := secn2-secn;     {Number of elapsed seconds}
  211.       IF diff < 0 THEN        { we just went over the minute }
  212.         diff := diff+60;      { so add 60 seconds }
  213.     UNTIL diff > hold;        { has our time expired yet }
  214.   END;                        { procedure TimeDelay }
  215.  
  216.   {------------------------------------------------------------------}
  217.   {          Get Absolute postion of Cursor into parameters x,y      }
  218.   {------------------------------------------------------------------}
  219.   PROCEDURE Get_Abs_Cursor(VAR x, y : Integer);
  220.   VAR
  221.     Active_Page : Byte ABSOLUTE $0040 : $0062; { Current Video Page Index}
  222.     Crt_Pages : ARRAY[0..7] OF Integer ABSOLUTE $0040 : $0050;
  223.  
  224.   BEGIN
  225.  
  226.     X := Crt_Pages[active_page]; { Get Cursor Position       }
  227.     Y := Hi(X)+1;             { Y get Row                 }
  228.     X := Lo(X)+1;             { X gets Col position       }
  229.   END;
  230.   {------------------------------------------------------------------}
  231.   {          Turn the Video On/Off to avoid Read/Write snow          }
  232.   {------------------------------------------------------------------}
  233.   PROCEDURE Video(Switch : Boolean);
  234.   BEGIN
  235.     IF (Switch = Off) THEN
  236.       Port[CrtAdapter+4] := (VideoMode-VideoEnable)
  237.     ELSE Port[CrtAdapter+4] := (VideoMode OR VideoEnable);
  238.   END;
  239.   {------------------------------------------------------------------}
  240.   {     InitWin Saves the Current (whole) Screen                     }
  241.   {------------------------------------------------------------------}
  242.   PROCEDURE InitWin;
  243.     { Records Initial Window Dimensions }
  244.   BEGIN
  245.  
  246.     IF CrtMode = 7 THEN
  247.       Video_Buffer := $B000   {Set Ptr to Monobuffer      }
  248.     ELSE Video_Buffer := $B800; { or Color Buffer          }
  249.  
  250.     WITH Win.Dim DO
  251.       BEGIN x1 := 1; y1 := 1; x2 := crtwidth; y2 := 25 END;
  252.     Win.Depth := 0;
  253.     InitDone := True;         { Show initialization Done }
  254.   END;
  255.   {------------------------------------------------------------------}
  256.   {       BoxWin Draws a Box around the current Window               }
  257.   {------------------------------------------------------------------}
  258.   PROCEDURE BoxWin(x1, y1, x2, y2 : Integer; BD : Integer; FG : Byte; BG : Integer);
  259.  
  260.     { Draws a box, fills it with blanks, and makes it the current }
  261.     { Window.  Dimensions given are for the box; actual Window is }
  262.     { one unit smaller in each direction.                         }
  263.  
  264.   VAR
  265.     x, y, I : Integer;
  266.     TB, SID, TLC, TRC, BLC, BRC : Integer;
  267.  
  268.   BEGIN
  269.     IF Crtmode = 7 THEN BEGIN
  270.       FG := 7;
  271.       BG := 0;
  272.     END;
  273.     Window(x1, y1, x2, y2);
  274.     TextColor(FG);
  275.     TextBackground(BG);
  276.  
  277.     IF BD = 1 THEN BEGIN
  278.       TB := 196;              {Top Border}
  279.       SID := 179;             {Side Border}
  280.       TLC := 218;             {Top Left Corner}
  281.       TRC := 191;             {Top Right Corner}
  282.       BLC := 192;             {Bottom Left Corner}
  283.       BRC := 217;             {Bottom Right Corner}
  284.     END
  285.     ELSE BEGIN
  286.       TB := 205;
  287.       SID := 186;
  288.       TLC := 201;
  289.       TRC := 187;
  290.       BLC := 200;
  291.       BRC := 188;
  292.     END;
  293.  
  294.     IF BD <> 0 THEN BEGIN
  295.       { Top }
  296.       GoToXY(1, 1);           { Windo Origin        }
  297.       Write(Chr(TLC));        { Top Left Corner     }
  298.       FOR I := 2 TO x2-x1 DO  { Top Bar             }
  299.         Write(Chr(TB));
  300.       Write(Chr(TRC));        { Top Right Corner
  301.  
  302.                               { Sides  }
  303.       FOR I := 2 TO y2-y1 DO
  304.         BEGIN
  305.           GoToXY(1, I);       { Left Side Bar       }
  306.           Write(Chr(SID));
  307.           GoToXY(x2-x1+1, I); { Right Side Bar      }
  308.           Write(Chr(SID));
  309.         END;
  310.  
  311.       { Bottom }
  312.       GoToXY(1, y2-y1+1);     { Bottom Left Corner }
  313.       Write(Chr(BLC));
  314.       FOR I := 2 TO x2-x1 DO  { Bottom Bar         }
  315.         Write(Chr(TB));
  316.  
  317.       { Make it the current Window }
  318.       Window(x1+1, y1+1, x2-1, y2-1);
  319.       Write(Chr(BRC));        { Bottom Right Corner }
  320.     END; {If BD <> 0} ;
  321.  
  322.     GoToXY(1, 1);
  323.     TextColor(FG MOD 16);     { Take Low nibble 0..15  }
  324.     TextBackground(BG);       { Take High nibble  0..9 }
  325.     ClrScr;
  326.   END;
  327.   {------------------------------------------------------------------}
  328.   {       MkWin   Make a Window                                      }
  329.   {------------------------------------------------------------------}
  330.   PROCEDURE MkWin(x1, y1, x2, y2 : Integer; FG : Byte; BG : Integer; BD : Integer);
  331.     { Create a removable Window }
  332.  
  333.   BEGIN
  334.  
  335.     IF (InitDone = False) THEN { Initialize if not done yet }
  336.       InitWin;
  337.  
  338.     WITH Win DO Depth := Depth+1; { Increment Stack pointer }
  339.     IF Win.Depth > maxWin THEN
  340.       BEGIN
  341.         WriteLn(^G, ' Windows nested too deep ');
  342.         Halt
  343.       END;
  344.     {-------------------------------------}
  345.     {       Save contents of screen       }
  346.     {-------------------------------------}
  347.     Video(Off);               { Turn off Video to avoid Snow  }
  348.  
  349.     WITH Win DO
  350.       BEGIN
  351.         New(Stack[Depth]);    { Allocate Current Screen to Heap }
  352.         IF CrtMode = 7 THEN
  353.           Stack[Depth]^.Image := monobuffer { set pointer to it      }
  354.         ELSE
  355.           Stack[Depth]^.Image := colorbuffer;
  356.       END;
  357.  
  358.     Video(On);                { Turn the Video back on        }
  359.  
  360.     WITH Win DO
  361.       BEGIN                   { Save Screen Dimentions        }
  362.         Stack[Depth]^.Dim := Dim;
  363.         Stack[Win.Depth]^.x := WhereX; { Save Cursor Position          }
  364.         Stack[Win.Depth]^.y := WhereY;
  365.       END;
  366.  
  367.     { Validate the Window Placement}
  368.     IF (X2 > 80) THEN         { If off right of screen       }
  369.       BEGIN
  370.         Delta := (X2-80);     { Overflow off right margin    }
  371.         X1 := X1-Delta;       { Move Left window edge        }
  372.         X2 := X2-Delta;       { Move Right edge on 80        }
  373.       END;
  374.     IF (Y2 > 25) THEN         { If off bottom   screen       }
  375.       BEGIN
  376.         Delta := Y2-25;       { Overflow off right margin    }
  377.         Y1 := Y1-Delta;       { Move Top edge up             }
  378.         Y2 := Y2-Delta;       { Move Bottom  24              }
  379.       END;
  380.     { Create the Window New window }
  381.     BoxWin(x1, y1, x2, y2, BD, FG, BG);
  382.     Win.Dim.x1 := x1+1;
  383.     Win.Dim.y1 := y1+1;       { Allow for margins }
  384.     Win.Dim.x2 := x2-1;
  385.     Win.Dim.y2 := y2-1;
  386.  
  387.   END;
  388.   {------------------------------------------------------------------}
  389.   {     Remove Window                                                }
  390.   {------------------------------------------------------------------}
  391.   { Remove the most recently created removable Window }
  392.   { Restore screen contents, Window Dimensions, and   }
  393.   { position of cursor.  }
  394.   PROCEDURE RmWin;
  395.   VAR
  396.     Tempbyte : Byte;
  397.  
  398.   BEGIN
  399.     Video(Off);
  400.  
  401.     WITH Win DO
  402.       BEGIN                   { Restore next Screen       }
  403.         IF crtmode = 7 THEN
  404.           monobuffer := Stack[Depth]^.Image
  405.         ELSE
  406.           colorbuffer := Stack[Depth]^.Image;
  407.         Dispose(Stack[Depth]); { Remove Screen from Heap   }
  408.  
  409.         Video(On);
  410.  
  411.         WITH Win DO           { Re-instate the Sub-Window }
  412.           BEGIN               { Position the old cursor   }
  413.             Dim := Stack[Depth]^.Dim;
  414.             Window(Dim.x1, Dim.y1, Dim.x2, Dim.y2);
  415.             GoToXY(Stack[Depth]^.x, Stack[Depth]^.y);
  416.           END;
  417.  
  418.         Get_Abs_Cursor(x, y); { New Cursor Position       }
  419.         Tempbyte :=           { Get old Cursor attributes }
  420.         Mem[Video_Buffer:((x-1+(y-1)*80)*2)+1];
  421.  
  422.         TextColor(Tempbyte AND $0F); { Take Low nibble  0..15}
  423.         TextBackground(Tempbyte DIV 16); { Take High nibble  0..9 }
  424.         Depth := Depth-1
  425.       END;
  426.   END;
  427.   {------------------------------------------------------------------}
  428.   {------------------------------------------------------------------}
  429.  
  430.  
  431.   {-----------------------------------------------------------------------------}
  432.   {            S  T  A  Y  E  X  I  T                                           }
  433.   {-----------------------------------------------------------------------------}
  434.  
  435.   PROCEDURE Stay_Xit;
  436.     {-----------------------------------------------------------------------------}
  437.     {  Stay_Xit Check Terminate Keys                                              }
  438.     {                                                                             }
  439.     {  Clean up the Program ,Free the Environment block, the program segment      }
  440.     {  memory and return to Dos. Programs using this routine ,must be the         }
  441.     {  last program in memory, else ,a hole will be left causing Dos              }
  442.     {  to go GooGoo .                                                             }
  443.     {-----------------------------------------------------------------------------}
  444.  
  445.   BEGIN                       { Block }
  446.     Rmwin;
  447.     WriteLn('Stay-Resident program Terminating');
  448.  
  449.     SaveRegs.Ax := $25 SHL 8+Kybrd_Int;
  450.     SaveRegs.Ds := DOS_IntCS;
  451.     SaveRegs.Dx := DOS_IntIP; { Reset the Keyboard interrupt addr }
  452.     MsDos(SaveRegs);          { to its original value             }
  453.  
  454.     Saveregs.Ax := $49 SHL 8+0; { Free Allocated Block function}
  455.     Saveregs.Es := MemW[CSeg:$2C]; { Free environment block       }
  456.     MsDos(Saveregs);
  457.  
  458.     Saveregs.Ax := $49 SHL 8+0; { Free Allocated Block function}
  459.     Saveregs.Es := CSeg;      { Free Program                 }
  460.     MsDos(Saveregs);
  461.  
  462.     Intr($20, Regs);          { Return to Dos }
  463.  
  464.   END { StayXit } ;
  465.  
  466.   {----------------------------------------------------------------------}
  467.   {            C a l l    O r i g i n a l    I n t e r r u p t           }
  468.   {----------------------------------------------------------------------}
  469.   PROCEDURE CallOriginalIntr(VAR RegAx : Integer);
  470.     {Invoke the original DOS interrupt and  }
  471.   BEGIN                       {Return the value in parameter          }
  472.     INLINE(
  473.       $B4/$00/                {Mov Ah,Read function                   }
  474.       $9C/                    {Push Flags                             }
  475.       $2E/$FF/$1E/DOS_IntIP/  {Call Far [DOS_IntIP]                   }
  476.       $C4/$BE/RegAx/          {Les Di,KeyChr[Bp]                      }
  477.       $AB                     {StosW          Stuff in new KeyChr     }
  478.       );
  479.   END;                        {CallOriginalIntr}
  480.   {----------------------------------------------------------------------}
  481.   {           K e y i n   :   R e a d  K e a b o a r d                   }
  482.   {----------------------------------------------------------------------}
  483.   FUNCTION Keyin : Char;      { Get a key from the Keyboard           }
  484.   VAR Ch : Char;              { If extended key, fold above 127       }
  485.   BEGIN                       {---------------------------------------}
  486.     REPEAT UNTIL KeyPressed;
  487.     Read(Kbd, Ch);
  488.     IF (Ch = Esc) AND KeyPressed THEN
  489.       BEGIN
  490.         Read(Kbd, Ch);
  491.         Ch := Char(Ord(Ch)+127);
  492.       END;
  493.     Keyin := Ch;
  494.   END;                        {Keyin}
  495.   {----------------------------------------------------------------------}
  496.   {          B e e p   :  S o u n d  t h e  H o r n                      }
  497.   {----------------------------------------------------------------------}
  498.   PROCEDURE Beep(N : Integer); {------------------------------------------}
  499.   BEGIN                       {  This routine sounds a tone of frequency }
  500.     Sound(n);                 {  N for approximately 100 ms              }
  501.     Delay(100);               {------------------------------------------}
  502.     Sound(n DIV 2);
  503.     Delay(100);
  504.     NoSound;
  505.   END {Beep} ;
  506.  
  507.   {*************************************************************************}
  508.   {-------------------------------------------------------------------------}
  509.   {            THE FOLLOWING ARE THE USER INCLUDE ROUTINES                  }
  510.   {-------------------------------------------------------------------------}
  511.   {*************************************************************************}
  512.  
  513.   procedure filedirectory;
  514.   {simple sorted file directory}
  515.  
  516. CONST
  517.   maxfiles = 128;             {max number of files searched in a given directory}
  518. TYPE
  519.   drivename = STRING[2];
  520.   filename = STRING[13];
  521.   pathname = STRING[64];
  522.   darray = RECORD
  523.              num : Integer;
  524.              arr : ARRAY[1..maxfiles] OF filename;
  525.            END;
  526.   register = RECORD
  527.                CASE Integer OF
  528.                  1 : (ax, bx, cx, dx, bp, si, di, ds, es, flags : Integer);
  529.                  2 : (al, ah, bl, bh, cl, ch, dl, dh : Byte);
  530.              END;
  531.   dtarec = RECORD
  532.              dosnext : ARRAY[1..21] OF Byte;
  533.              attr : Byte;
  534.              ftime, fdate, flsize, fhsize : Integer;
  535.              fullname : ARRAY[1..13] OF Char;
  536.            END;
  537.  
  538. VAR
  539.   reg : register;
  540.   inpath : pathname;
  541.   dta : dtarec;
  542.   files : darray;
  543.   filnum : Integer;
  544.   lcount, olddtaseg,olddtaofs:integer;
  545.   drivenum:byte;
  546.   stop:boolean;
  547.  
  548.   FUNCTION stlocase(st : filename) : filename;
  549.     {-convert a string to lowercase}
  550.   VAR i : Integer;
  551.   BEGIN
  552.     FOR i := 1 TO Length(st) DO
  553.       IF (st[i] >= 'A') AND (st[i] <= 'Z') THEN
  554.         st[i] := Chr(Ord(st[i])+32);
  555.     stlocase := st;
  556.   END;                        {stlocase}
  557.  
  558. procedure storedta(var dtaseg,dtaofs:integer);
  559.   {-return the old dta address}
  560. begin
  561.     reg.ah := $2F;
  562.     MsDos(reg);
  563.     dtaseg:=reg.es;
  564.     dtaofs:=reg.bx;
  565. end; {storedta}
  566.  
  567.   PROCEDURE setdta(dtaseg,dtaofs:integer);
  568.     {-set new DTA address}
  569.   BEGIN
  570.     reg.ah := $1A;
  571.     reg.ds := dtaseg;
  572.     reg.dx := dtaofs;
  573.     MsDos(reg);
  574.   END;                        {setdta}
  575.  
  576.   PROCEDURE getfiles(VAR files : darray; VAR inpath : pathname);
  577.     {-return the files in the files array}
  578.   VAR
  579.     name : filename;
  580.     startpath : pathname;
  581.  
  582.     FUNCTION fileexists(VAR s : pathname; attr : Integer) : Boolean;
  583.       {-determine whether a file exists with the specified attribute}
  584.     BEGIN
  585.       reg.ah := $4E;
  586.       s[Length(s)+1] := #0;
  587.       reg.ds := Seg(s);
  588.       reg.dx := Ofs(s[1]);
  589.       reg.cx := attr;
  590.       MsDos(reg);
  591.       fileexists := ((reg.flags AND 1) = 0) AND ((dta.attr AND 31) = attr);
  592.     END;                      {fileexists}
  593.  
  594.     PROCEDURE expandpath(VAR start, outpath : pathname);
  595.       {-add wildcards to path}
  596.     CONST
  597.       drivelets:string[26]='ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  598.     VAR
  599.       ch : Char;
  600.       colpos:byte;
  601.     BEGIN
  602.       colpos:=pos(':',start);
  603.       if colpos=0 then
  604.         drivenum:=0
  605.       else
  606.         drivenum:=pos(upcase(start[pred(colpos)]),drivelets);
  607.       IF start = '' THEN BEGIN
  608.         outpath := '*.*';
  609.         Exit;
  610.       END;
  611.       ch := start[Length(start)];
  612.       IF (ch = '\') OR (ch = ':') THEN BEGIN
  613.         outpath := start+'*.*';
  614.         Exit;
  615.       END;
  616.       IF fileexists(start, 16) THEN BEGIN
  617.         outpath := start+'\*.*';
  618.         Exit;
  619.       END;
  620.       outpath := start;
  621.     END;                      {expandpath}
  622.  
  623.     PROCEDURE parsedta(VAR name : filename);
  624.       {-return a name and extension from a DTA}
  625.     VAR
  626.       i : Byte;
  627.     BEGIN
  628.       i := 1;
  629.       WHILE dta.fullname[i] <> #0 DO i := i+1;
  630.       Move(dta.fullname, name[1], i-1);
  631.       name[0] := Chr(i-1);
  632.     END;                      {parsedta}
  633.  
  634.     FUNCTION getfirst(VAR startpath : pathname;
  635.                       VAR name : filename) : Boolean;
  636.       {-return true and a name if first file is found}
  637.     VAR
  638.       foundone : Boolean;
  639.     BEGIN
  640.       reg.ah := $4E;
  641.       reg.ds := Seg(startpath);
  642.       reg.dx := Ofs(startpath[1]);
  643.       reg.cx := 17;
  644.       MsDos(reg);
  645.       foundone := ((reg.flags AND 1) = 0);
  646.       IF foundone THEN
  647.         {scan the DTA for the file name and extension}
  648.         parsedta(name);
  649.       getfirst := foundone;
  650.     END;                      {getfirst}
  651.  
  652.     FUNCTION getnext(VAR name : filename) : Boolean;
  653.       {-return true and a name if another file is found}
  654.     VAR
  655.       foundone : Boolean;
  656.     BEGIN
  657.       reg.ah := $4F;
  658.       reg.ds := Seg(dta);
  659.       reg.dx := Ofs(dta);
  660.       MsDos(reg);
  661.       foundone := ((reg.flags AND 1) = 0);
  662.       IF foundone THEN
  663.         {scan the DTA for the file name and extension}
  664.         parsedta(name);
  665.       getnext := foundone;
  666.     END;                      {getnext}
  667.  
  668.   BEGIN
  669.     expandpath(inpath, startpath);
  670.     WITH files DO BEGIN
  671.       startpath[Length(startpath)+1] := #0;
  672.       num := 0;
  673.       IF getfirst(startpath, name) THEN
  674.         REPEAT
  675.           IF name[1] <> '.' THEN BEGIN
  676.             num := Succ(num);
  677.             arr[num] := name;
  678.             IF (dta.attr AND 16) <> 0 THEN arr[num] := arr[num]+'\';
  679.           END;
  680.         UNTIL (num = maxfiles) OR NOT(getnext(name));
  681.     END;
  682.   END;                        {getfiles}
  683.  
  684.   PROCEDURE sortfiles(VAR files : darray; l, r : Integer);
  685.     {-sort via recursive quicksort}
  686.   VAR
  687.     i, j : Integer;
  688.     part : filename;
  689.  
  690.     PROCEDURE Swap(i, j : Integer);
  691.       {-swap the two referenced data elements}
  692.     VAR
  693.       t : filename;
  694.     BEGIN
  695.       WITH files DO BEGIN
  696.         t := arr[i];
  697.         arr[i] := arr[j];
  698.         arr[j] := t;
  699.       END;
  700.     END;                      {swap}
  701.  
  702.   BEGIN
  703.  
  704.     IF l < r THEN WITH files DO BEGIN
  705.  
  706.       i := l;
  707.       j := Succ(r);
  708.  
  709.       {get a random partitioning element}
  710.       Swap(i, i+Random(j-i));
  711.       part := arr[i];
  712.  
  713.       {swap elements until all less than partition are to left, etc}
  714.       REPEAT
  715.         REPEAT
  716.           i := Succ(i);
  717.         UNTIL (i > j) OR (arr[i] >= part);
  718.         REPEAT
  719.           j := Pred(j);
  720.         UNTIL (arr[j] <= part);
  721.         IF i < j THEN Swap(j, i);
  722.       UNTIL i >= j;
  723.  
  724.       Swap(l, j);
  725.       sortfiles(files, l, Pred(j));
  726.       sortfiles(files, Succ(j), r);
  727.     END;
  728.  
  729.   END;                        {sortfiles}
  730.  
  731. function bytesavailable(drivenum:byte):real;
  732. begin
  733.   reg.ah:=$36;
  734.   reg.dl:=drivenum;
  735.   msdos(reg);
  736.   bytesavailable:=1.0*reg.bx*reg.ax*reg.cx;
  737. end; {bytesavailable}
  738.  
  739.   PROCEDURE checkmore(VAR j : Integer;var stop:boolean);
  740.     {-see if user wants to see more}
  741.   VAR
  742.     c : Char;
  743.   BEGIN
  744.     stop := False;
  745.     Write('....more?  ');
  746.     Read(Kbd, c);
  747.     IF (c = ' ') OR (UpCase(c) = 'Y') THEN
  748.       j := 1
  749.     ELSE IF c = ^M THEN
  750.       j := j-1
  751.     ELSE
  752.       stop := True;
  753.     Write(Con, ^M); ClrEol;
  754.   END;                        {checkmore}
  755.  
  756. BEGIN
  757.   write('Enter directory mask: ');
  758.   readln(inpath);
  759.   storedta(olddtaseg,olddtaofs);
  760.   setdta(seg(dta),ofs(dta));
  761.   getfiles(files, inpath);
  762.   sortfiles(files, 1, files.num);
  763.   WriteLn;
  764.   lcount:=1;
  765.   filnum:=1;
  766.   stop:=false;
  767.   while (filnum<=files.num) and not(stop) do begin
  768.     Write(stlocase(files.arr[filnum]), '':(15-Length(files.arr[filnum])));
  769.     IF (filnum MOD 5) = 0 THEN begin
  770.       WriteLn;
  771.       lcount:=succ(lcount);
  772.       if lcount>=12 then checkmore(lcount,stop);
  773.     end;
  774.     filnum:=succ(filnum);
  775.   END;
  776.   IF (files.num MOD 5) <> 0 THEN WriteLn;
  777.   if not(stop) then writeln;
  778.   write('bytes available: ',bytesavailable(drivenum):0:0);
  779.   setdta(olddtaseg,olddtaofs);
  780. END; {filedirectory}
  781.  
  782.   {----------------------------------------------------------------------}
  783.   {        D   E  M  O                                                   }
  784.   {----------------------------------------------------------------------}
  785.   PROCEDURE Demo;             { Give Demonstration of Code        }
  786.   VAR
  787.     Trash : Char;
  788.     attribyte,
  789.     OldAttribute : Byte;
  790.     Xcursor : Integer;
  791.     Ycursor : Integer;
  792.  
  793.   BEGIN
  794.     KeyChr := #0;             { Clear any residual krap    }
  795.     MkWin(1, 5, 80, 20, white{Cyan}, Black, 2); { Make a Biiiiiiig window    }
  796.     ClrScr;                   { Clear screen out           }
  797.     filedirectory;
  798.     { Make a little Window and hold for }
  799.     { user to give us a goose..or whatever}
  800.     GoToXY(Xcursor, Ycursor);
  801.     mkwin(60,21,72,24,Cyan, Black, 2);
  802.     GoToXY(1, 1);
  803.     Write('Press a key . . .');
  804.  
  805.     WHILE (NOT KeyPressed);   { Pause until Key pressed }
  806.     WHILE KeyPressed DO       { Get Ctrl-Home maybe     }
  807.       Read(Kbd, KeyChr);      { Read the users Key      }
  808.     RmWin;                    { Remove the Window       }
  809.     IF KeyChr = Quit_Key THEN { If Terminate Key then   }
  810.       Stay_Xit;               { remove ourself from  Memory }
  811.  
  812.     RmWin;                    { Remove the big window      }
  813.   END;                        { Demo }
  814.  
  815.  
  816.   {-------------------------------------------------------------------------}
  817.   {              P R O C E S S   I N T E R R U P T                          }
  818.   { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  819.   PROCEDURE Process_Intr;
  820.  
  821.   BEGIN
  822.     {This Inline routine will save the regs and Stack for Stay resident programs.
  823.     It restores DS and SS from the previously saved integer constants "OurDseg"
  824.     and "OurSSeg". This is important since Dos is not re-entrant and any attempt
  825.     to use Interrupt I/O services will clobber the very stack on which the
  826.     Resident Turbo program just saved its regs. Thus, on the final return, you
  827.     and Toto will end up somewhere other than Kansas and without your Ruby Reds.
  828.     }
  829.  
  830.     { author:      Lane Ferris
  831.     - The Hunter's Helper -
  832.  
  833.     Distributed to the Public Domain for use without profit.
  834.     Original Version 5.15.85
  835.     }
  836.     { On entry the Stack will already contain: }
  837.     {  1) Sp for Dos                           }
  838.     {  2) Bp for Dos                           }
  839.     {  3) Ip for Dos                           }
  840.     {  4) Cs for Dos                           }
  841.     {  5) Flags for Dos                        }
  842.     INLINE(
  843.  
  844.       { The following routine avoids the overhead of saving the DOS stack         }
  845.       { when the INT 16 function was not for a character request. This happens    }
  846.       { often (every four chars) as DOS checks on ^S/^Q/^C/Keypressed  ad.nausea  }
  847.  
  848.       $9C/                    {PushF         Save Flags             }
  849.       $80/$FC/$00/            {Cmp Ah,00     If Char request,       }
  850.       $75/$11/                {Jne  Skipit   Not for us.            }
  851.       $2E/
  852.       $FF/$1E/Dos_Intip/      {Call Far Cs:[Original$16]            }
  853.       $9C/                    {PushF          Save Return Flags     }
  854.       $80/$FC/Our_Char/       {Cmp   Ah,Cs:OurChar  Our Key?        }
  855.       $74/$0E/                {Je GotIt       enter Staysave code   }
  856.       $9D/                    {POPF           Restore $16 flags     }
  857.       $5D/$5D/                {Pop BP/PopBP   Restore BP            }
  858.       $CA/$02/$00/            {RetF 2   Return w/Key discard flags  }
  859.  
  860.       {Skipit}                {Jmp to Original Dos Intr $16         }
  861.       $9D/                    {PopF  Restore the Flags              }
  862.       $5D/$5D/                {Pop  Bp/Pop Bp else  Restore Bp &    }
  863.       $2E/                    {     Jump to Original Dos Interrupt  }
  864.       $FF/$2E/Dos_IntIP/      {Jmp Far Cs:[DOS_IntIp]               }
  865.  
  866.       { Move the current active registers to a save place}
  867.       {GotIt}
  868.       $9D/                    {Pop Saved Flags}
  869.       $FA/                    {Cli         Stop all interrupts       }
  870.       { Bp and Sp aready saved at Begin Stmt }
  871.       $55/                    {Push   Bp  Save again for Regpak      }
  872.       $BD/Regs/               {Mov    Bp,offset REGS address savearea}
  873.       $2E/$89/$46/$00/        {CS:Mov [Bp+0],AX Save Users Registers }
  874.       $2E/$89/$5E/$02/        {Cs:Mov [Bp+2],Bx}
  875.       $2E/$89/$4E/$04/        {CS:Mov [Bp+4],CX}
  876.       $2E/$89/$56/$06/        {CS:Mov [Bp+6],DX}
  877.       $2E/$8F/$46/$08/        {Pop    Cs:[Bp+8] Fetch Bp from stack  }
  878.       $2E/$89/$76/$0A/        {CS:Mov [Bp+A],SI}
  879.       $2E/$89/$7E/$0C/        {CS:Mov [Bp+C],DI}
  880.       $2E/$8C/$5E/$0E/        {CS:Mov [Bp+E],DS}
  881.       $2E/$8C/$46/$10/        {CS:Mov [Bp+10],ES}
  882.       $9C/                    {PUSHF  put Flags on stack to retrieve }
  883.       $2E/$8F/$46/$12/        {POP Cs:[Bp+12]}
  884.  
  885.       { If Current SS := [OurSseg] or (Inuse = True), }
  886.       { then dont overlay the previously saved stack. }
  887.       { This program is being recursive.              }
  888.  
  889.       $2E/$80/$3E/Inuse/$01/  {Cmp  Cs:[Inuse],1   Inuse = True ?         }
  890.       $74/$62/                {Je   ReCurin        Yes, -J-U-M-P-         }
  891.  
  892.       { Switch the SS:Sp reg pair over to ES:Si       }
  893.       { Put Turbo's Stack pointers into SS:Sp         }
  894.  
  895.       $2E/$8C/$16/DosSSeg/    {Mov  Cs:DosSSeg,SS Save Dos Stack Segment    }
  896.       $8C/$D6/                {Mov  Si,SS         Es gets Dos stack         }
  897.       $8E/$C6/                {Mov  Es,Si                                   }
  898.       $2E/$8E/$16/OurSSeg/    {Mov  SS,Cs:OurSSeg SS Gets our Stack segment }
  899.       $2E/$8E/$1E/OurDseg/    {Mov  Ds,Cs:Our_Ds  DS Gets our Data Segment  }
  900.  
  901.       { If ES:Si (stack ptr) <>  OurSSeg  then        }
  902.       { Sp := Virgin Turbo Stack pointer.             }
  903.       { If Es:Si := OurSSeg, then this is a Read or   }
  904.       { Write before Inuse was set True. Dont clobber }
  905.       { the current setting of Turbo stack pointer.   }
  906.  
  907.       $2E/$3B/$36/OurSSeg/    {Cmp  Si,Cs:OurSSeg If SS := OurSSeg then     }
  908.       $89/$E6/                {Mov  Si,Sp         dont clobber saved regs   }
  909.       $74/$05/                {Je   $+5           else get virgin stack ptr }
  910.       $3E/$8B/$36/$74/$01/    {Mov  Si,Ds:[174]   ..(cf. code at B2B 3.0x)  }
  911.       $87/$F4/                {Xchg Sp,Si         Set new  Stack Pointer    }
  912.  
  913.       { Stack Dos/User interrupted pgm regs for Exit. }
  914.       { These are the original interrupt process regs }
  915.       { that must be returned on interrupt return     }
  916.  
  917.       $2E/$FF/$76/$00/        {Push [Bp+0]  Save Ax                         }
  918.       $2E/$FF/$76/$02/        {Push [Bp+2]  Save Bx                         }
  919.       $2E/$FF/$76/$04/        {Push [Bp+4]  Save Cx                         }
  920.       $2E/$FF/$76/$06/        {Push [Bp+6]  Save Dx                         }
  921.       {Push [Bp+8]  Save Bp                         }
  922.       $2E/$FF/$76/$0A/        {Push [Bp+A]  Save Si                         }
  923.       $2E/$FF/$76/$0C/        {Push [Bp+C]  Save Di                         }
  924.       $2E/$FF/$76/$0E/        {Push [Bp+E]  Save Ds                         }
  925.       $2E/$FF/$76/$10/        {Push [Bp+10] Save Es                         }
  926.  
  927.       { Now stack the lesser of current stack size or  }
  928.       { 40 Words to our stack, to be re-stack on the   }
  929.       { interrupted pgms stack on exit. This is done   }
  930.       { to allow recursive entry into Dos/or other non }
  931.       { re-entrant pgms.                               }
  932.  
  933.       $29/$C9/                {Sub  Cx,Cx  Find minimum of current stack    }
  934.       $29/$F1/                {Sub  Cx,Si  size or 40 words to save.        }
  935.       $D1/$E9/                {Shr  Cx,1   Stackbytes/2 for words.          }
  936.       $83/$F9/$40/            {Cmp  Cx,+40 This keeps up from overrunning   }
  937.       $7E/$03/                {Jle  $+3    the Stack Segment when it is less}
  938.       $B9/$40/$00/            {Mov  Cx,40  than Dos stack size              }
  939.       $2E/$89/$0E/StackSize/  {Mov  Cs:StackSize,Cx Save current stack size }
  940.       {Restack:}
  941.       $26/$FF/$34/            {Push Es:[Si] Our Stack := Dos Es:Si          }
  942.       $46/$46/                {Inc  Si/Inc Si Get Next Dos Stack Word       }
  943.       $E2/$F9/                {Loop to Restack                              }
  944.  
  945.       $56/                    {Push Si            Save bottom of Dos Stack  }
  946.       $2E/$8C/$5E/$0E/        {Mov  Cs:[Bp+E],Ds  Set New Data Segmt in regs}
  947.       {Recurin}               {                     Jump here if Recursion  }
  948.       $FB                     {Sti Enable Interrupts                        }
  949.  
  950.       );
  951.  
  952.  
  953.     { Check the Int 16 request function in Ah reg:  }
  954.     {       0 = read character from Keyboard        }
  955.     {       1 = check character available           }
  956.     {       2 = check shift key values              }
  957.     IF Halfregs.Ah = Ord(Our_Char) { Separate the tests so code    }
  958.     THEN IF (NOT InUse) THEN  { performs efficiently.         }
  959.       { Must be OUR key and not busy  }
  960.       BEGIN                   { Demo }
  961.         InUse := True;        { "dont clobber saved stack"}
  962.         Demo;
  963.         CallOriginalIntr(Regs.Ax); { Get input key for the users     }
  964.         IF HalfRegs.Ah = Ord(Our_Char) THEN Beep(650);
  965.  
  966.         InUse := False;       { ok to restore interrupted stack }
  967.       END;                    { Demo }
  968.  
  969.     {Version 3.31}
  970.     { Inline Code to restore the stack and regs moved}
  971.     { to the Turbo Resident Stack which allows       }
  972.     { re-entrancy into Dos for I/O and  recursion    }
  973.     { for Turbo Terminate & Stay Resident programs.  }
  974.  
  975.     { Author: Lane Ferris                                       }
  976.     {         - The Hunter's Helper -                           }
  977.     { Distributed to the Public Domain for use without profit.  }
  978.     { Original Version 5.15.85                                  }
  979.     {----------------------------------------------------------------------}
  980.     {        Restore the Dos (or interrupted pgm) Regs and Stack           }
  981.     {----------------------------------------------------------------------}
  982.     { On entry the Stack will already contain: }
  983.     {    Pointer to bottom of stack            }
  984.     {    Bottom of Dos Stack Ptr               }
  985.     {    StackSize words of saved pgm stack    }
  986.     {    Dos Flags                             }
  987.     {    Dos Code Segment                      }
  988.     {    Dos Instruction Ptr                   }
  989.     {    Dos Base Pointer                      }
  990.     {    Dos Original Stack Ptr                }
  991.  
  992.  
  993.     { Retrieve the Regpack registers as they were    }
  994.     { stored for the Interrupt Entry.                }
  995.  
  996.     INLINE(
  997.       $BD/Regs/               {Mov    Bp,offset REGS}
  998.       $2E/$8B/$46/$00/        {CS:Mov Ax,[Bp+0]}
  999.       $2E/$8B/$5E/$02/        {Cs:Mov Bx,[Bp+2]}
  1000.       $2E/$8B/$4E/$04/        {CS:Mov Cx,[Bp+4]}
  1001.       $2E/$8B/$56/$06/        {CS:Mov Dx,[Bp+6]}
  1002.  
  1003.       $2E/$8B/$76/$0A/        {CS:Mov Si,[Bp+A]}
  1004.       $2E/$8B/$7E/$0C/        {CS:Mov Di,[Bp+C]}
  1005.       $2E/$8E/$5E/$0E/        {CS:Mov DS,[Bp+E]}
  1006.       $2E/$8E/$46/$10/        {CS:Mov ES,[Bp+10]}
  1007.       $2E/$FF/$76/$12/        {Push Cs:[Bp+12]  }
  1008.       {PopF             }
  1009.       { The following code was added to avoid }
  1010.       { the 80286 Pop flag (POPF) bug which   }
  1011.       { enables interrupts while we are trying}
  1012.       { to POP  the stack on odd byte boundry }
  1013.       $EB/$01/                {JMP $+3 Skip over IRET   }
  1014.       $CF/                    {IRET    POP IP/CS/Flags  }
  1015.       $0E/                    {PUSH CS Make a return    }
  1016.       $E8/$FB/$FF/            {CALL CS:$-2 Pop the Flags}
  1017.  
  1018.       { If [Cs:InUse]:= True,  then dont restore the stack.}
  1019.       { This program is being recursive. Else restore  Dos }
  1020.       { Stack and Program Entry registers for final exit.  }
  1021.  
  1022.       $2E/$80/$3E/Inuse/$01/  {Cmp  byte ptr Cs:[Inuse],1                   }
  1023.       $74/$25/                {Je   ReCurOut   J-U-M-P                      }
  1024.  
  1025.       { Move "StackSize" words back to the interrupted pgms}
  1026.       { stack. The originals could have been clobber by our}
  1027.       { being recursive. (Especially true of DOS)          }
  1028.  
  1029.       $FA/                    { Cli      ; Stop all interrupts    }
  1030.       $5E/                    {Pop Si     Bottom of Dos Stack              }
  1031.       $2E/$8B/$0E/StackSize/  {Mov Cx,Cs:StackSize Saved Stack Words       }
  1032.       $2E/$8E/$06/DosSSeg/    {Mov ES,Cs:DosSSeg Get Dos StackSegment      }
  1033.       {Restack:}
  1034.       $4E/$4E/                {Dec Si/Dec Si     Backup Dos Stack          }
  1035.       $26/$8F/$04/            {Pop Es:[Si]       Dos Stack := Our Stack    }
  1036.       $E2/$F9/                {Loop to Restack                             }
  1037.       $89/$F5/                {Mov Bp,Si         Save Dos Sp across Pops   }
  1038.  
  1039.       {         - C - A - U - T - I - O - N -              }
  1040.       { Restore the original interrupted programs regs     }
  1041.       { except Ax. Ax usually contains status. It contains }
  1042.       { a scan code and key for Int 16. You may want to    }
  1043.       { rework this if using another interrupt.            }
  1044.  
  1045.       $07/                    {Pop  Es                                     }
  1046.       $1F/                    {Pop  Ds                                     }
  1047.       $5F/                    {Pop  Di                                     }
  1048.       $5E/                    {Pop  Si                                     }
  1049.       $5A/                    {Pop  Dx                                     }
  1050.       $59/                    {Pop  Cx                                     }
  1051.       $5B/                    {Pop  Bx                                     }
  1052.       $44/$44/                {Inc sp/Inc sp Thow old Ax value away        }
  1053.  
  1054.       $89/$EC/                {Mov  Sp,Bp         Setup Dos Stack Ptr     }
  1055.       $2E/$8E/$16/DosSSeg/    {Mov  SS,Cs:DosSSeg Give back Dos Stack     }
  1056.  
  1057.       {RecurOut}              {Clean up the Stack                }
  1058.       $5D/                    {Pop Bp     Throw away old dos Sp  }
  1059.       $BD/Regs/               {Mov Bp,offset REGS                }
  1060.       $2E/$FF/$76/$12/        {Push Cs:[Bp+12]  Flags from last  }
  1061.       {PopF             interrupt.       }
  1062.       { The following code was added to avoid  }
  1063.       { the 80286 Pop flag (POPF) bug which    }
  1064.       { enables interrupts while we are trying }
  1065.       { to POP  the stack on odd byte boundry  }
  1066.  
  1067.       $EB/$01/                {JMP $+3 Skip over IRET   }
  1068.       $CF/                    {IRET    POP IP/CS/Flags  }
  1069.       $0E/                    {PUSH CS Make a return    }
  1070.       $E8/$FB/$FF/            {CALL CS:$-2 Pop the Flags}
  1071.  
  1072.       $5D/                    {Pop Bp  Retrieve old BP        }
  1073.       $FB/                    {Sti     Enable interrupts      }
  1074.       $CA/$02/$00             {Ret Far 002 Thow old flags away}
  1075.       );
  1076.  
  1077.  
  1078.   END;                        {Process_Intr}
  1079.  
  1080.   {-------------------------------------------------------------------------}
  1081.   {                             M  A  I  N                                  }
  1082.   {-------------------------------------------------------------------------}
  1083.   { The main program installs the new interrupt routine }
  1084.   { and makes it permanently resident as the keyboard   }
  1085.   { interrupt.  The old keyboard interrupt is addressed }
  1086.   { through #60H, so it can still be used.              }
  1087.   {                                                     }
  1088.   { The following dos calls are used:                   }
  1089.   { Function 25 - Install interrupt address             }
  1090.   {               input al = int number,                }
  1091.   {               ds:dx = address to install            }
  1092.   { Function 35 - get interrupt address                 }
  1093.   {               input al = int number                 }
  1094.   {               output es:bx = address in interrupt   }
  1095.   { Function 31 - terminate and stay resident           }
  1096.   {               input dx = size of resident program   }
  1097.   {               obtained from the memory              }
  1098.   {               allocation block at [Cs:0 - $10 + 3]  }
  1099.   { Function 49 - Free Allocated Memory                 }
  1100.   {               input Es = Block Segment to free      }
  1101.   { Interrupt 20 - Return to invoking process           }
  1102.   {-----------------------------------------------------}
  1103. BEGIN                         {**main**}
  1104.  
  1105.   InUse := False;             { Turn off the Inuse flag in case we do a write}
  1106.   OurDseg := DSeg;            { Save the Data Segment Address for Interrupts }
  1107.   OurSseg := SSeg;            { Save our Stack Segment for Interrupts        }
  1108.  
  1109.  
  1110.   Terminate_Flag := False;    { Havent received a Kill key yet   }
  1111.   SaveRegs.Es := 00;          { Clear for Dos 3.0 bug            }
  1112.   { now install the interrupt routine}
  1113.  
  1114.   { Initialize Your Progam Here since you wont get }
  1115.   { control again until "Our_Char" is entered from }
  1116.   { the Keyboard.                                  }
  1117.  
  1118.   SaveRegs.Ax := $3500+Kybrd_Int;
  1119.   Intr($21, SaveRegs);        {get the address of keyboard interrupt }
  1120.  
  1121.   DOS_IntIp := SaveRegs.BX;   { Location of DOS Interrupt Ip }
  1122.   DOS_IntCs := SaveRegs.Es;   { Location of DOS Interrupt Cs }
  1123.  
  1124.   SaveRegs.Ax := $2500+Kybrd_Int;
  1125.   SaveRegs.Ds := CSeg;
  1126.   SaveRegs.Dx := Ofs(Process_Intr);
  1127.   Intr($21, SaveRegs);        { set the keyboard interrupt to point to
  1128.                               "Process-Intr" above}
  1129.  
  1130.  
  1131.   WriteLn(' Turbo Stay-Resident DIR program (3.33): Press Alt-F10');
  1132.   writeln(' Resident interface by Lane Ferris and Neil Rubenking');
  1133.  
  1134.   {****************************************************************************}
  1135.   {----------------------------------------------------------------------------}
  1136.   {               END OF INITALIZE PROGRAM CODE                                }
  1137.   {----------------------------------------------------------------------------}
  1138.   {****************************************************************************}
  1139.   { Now terminate and stay resident        }
  1140.   { The following Call utilizes the new    }
  1141.   { Terminate & Stay Resident function     }
  1142.   { by passing the Memory Control Block    }
  1143.   { allocation size set when Turbo prolog  }
  1144.   { issued Int 21/function 4A(shrink block)}
  1145.   { calculated from mInimum and mAximum op-}
  1146.   { tions menu. The MCB sits one paragraph }
  1147.   { above the PSP.                         }
  1148.   { Pass return code of zero    }
  1149.   SaveRegs.Ax := $3100;       { Terminate and Stay Resident }
  1150.   SaveRegs.Dx := MemW[CSeg-1:0003]; { Prog_Size from Allocation Blk}
  1151.   Intr($21, SaveRegs);
  1152.  
  1153.   { END OF RESIDENCY CODE }
  1154. END.
  1155.